home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacWorld 1997 September
/
Macworld (1997-09).dmg
/
Shareware World
/
Utilities
/
Text Processing
/
AlphaLite.6.52
/
Tcl
/
Modes
/
htmlExtra.tcl
< prev
next >
Wrap
Text File
|
1997-01-21
|
19KB
|
682 lines
#===============================================================================
#
# htmlExtra.tcl
#
# Part of HTML mode 1.4
#
# Routines for giving attributes in the status bar.
#
# Copyright 1996, 1997 by Johan Linde <jl@theophys.kth.se>.
# This software may be used freely, and distributed freely, as long as
# the receiver is not obligated in any way by receiving it.
#
# If you make improvements to this file, please share them!
#
#===============================================================================
# Opening or only tag of an element - include attributes
# Status bar for each attribute.
# Return empty string if user skips an attribute which must be used.
proc htmlOpenElemLoop {elem used wrPos} {
global htmlActiveElem htmlActiveUsed htmlActiveAttr htmlActiveCache
global HTMLmodeVars htmlPackageToUse htmlElemEventHandler1
global htmlURLAttr htmlColorAttr htmlWindowAttr htmlWrapPos
global htmlSpecURL htmlSpecColor htmlSpecWindow htmlActiveWidth htmlActiveHeight
set promptNoisily $HTMLmodeVars(promptNoisily)
if {![string length $used]} {set used $elem}
set elem [string toupper $elem]
set used [string toupper $used]
set htmlActiveUsed $used
set htmlActiveElem $elem
set text "<"
append text [htmlSetCase $elem]
# if there are attributes to ask about, do so
set reqatts [htmlGetRequired $used]
set useatts [htmlGetUsed $used]
set askformore [htmlGetAttrMore $used]
set optatts [htmlGetOptional $used]
set NumberAttrs [htmlGetNumber $used]
# Add missing required attributes.
foreach a $reqatts {
if {[lsearch -exact $useatts $a] < 0} {
set useatts "$a $useatts"
}
}
# Remove extra attributes
foreach a $useatts {
if {[lsearch -exact $reqatts $a] < 0 && [lsearch -exact $optatts $a] < 0} {
set where [lsearch -exact $useatts $a]
set useatts [lreplace $useatts $where $where]
}
}
set allatts $useatts
set eventatts ""
# If the ask for more flag is set, add the rest of the attributes.
if {$askformore} {
foreach attr $optatts {
if {[lsearch -exact $useatts $attr] < 0} { lappend allatts $attr}
}
# optionally include event handlers
if {$HTMLmodeVars(inclEventHandler) && $htmlPackageToUse == 1 && \
[info exists htmlElemEventHandler1($used)]} {
set eventatts $htmlElemEventHandler1($used)
append allatts " " $eventatts
}
}
# wrapping
set htmlWrapPos [expr $wrPos == -1 ? [lindex [posToRowCol [getPos]] 1] : $wrPos]
incr htmlWrapPos [expr [string length $text] + 1]
for {set i 0} {$i < [llength $allatts]} {incr i} {
set attr [lindex $allatts $i]
if {$i == [llength $useatts]} {
# it's time to ask if more is wanted
if {$promptNoisily} {beep}
set more ""
if {$used == "LI IN UL" || $used == "LI IN OL"} {
set pr "LI:"
} else {
set pr "${used}:"
}
while {[catch {statusPrompt "$pr More attributes? \[n\] " htmlStatusAskYesOrNo} more]} {
if {$more == "Cancel all!"} {
message "Cancel"
error
}
}
if {$more != "yes"} { break }
}
if {[lsearch -exact $reqatts $attr] >= 0} {
set required 1
} else {
set required 0
}
set htmlActiveAttr $attr
set a2 [string trimright $attr =]
if {[string index $attr [expr [string length $attr] - 1]] == "="} {
if {([lsearch -exact $htmlURLAttr $attr] >= 0 && [lsearch -exact $htmlSpecURL "${used}!=$a2"] < 0) || \
[lsearch -exact $htmlSpecURL "${used}=$a2"] >= 0} {
# URL attibute
set htmlActiveCache URLs
if {[catch {htmlAskURL $attr $required} v]} {
if {$v != "Skip rest!"} {
error
} elseif {!$required} {
set i [llength $allatts]
} else {
set v ""
}
} elseif {[string length $v]} {
append text [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes [htmlURLescape2 $v]]"]
}
} elseif {([lsearch -exact $htmlColorAttr $attr] >= 0 && [lsearch -exact $htmlSpecColor "${used}!=$a2"] < 0) || \
[lsearch -exact $htmlSpecColor "${used}=$a2"] >= 0} {
# Color attribute
if {[catch {htmlAskColor $attr $required} v]} {
if {$v != "Skip rest!"} {
error
} elseif {!$required} {
set i [llength $allatts]
} else {
set v ""
}
} elseif {[string length $v]} {
append text [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $v]"]
}
} elseif {([lsearch -exact $htmlWindowAttr $attr] >= 0 && [lsearch -exact $htmlSpecWindow "${used}!=$a2"] < 0) || \
[lsearch -exact $htmlSpecWindow "${used}=$a2"] >= 0} {
# Window attribute
set htmlActiveCache windows
if {[catch {htmlAskURL $attr $required} v]} {
if {$v != "Skip rest!"} {
error
} elseif {!$required} {
set i [llength $allatts]
} else {
set v ""
}
} elseif {[string length $v]} {
append text [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $v]"]
}
} elseif {[lsearch $NumberAttrs "$attr*"] >= 0} {
# Number attribute
if {[catch {htmlAskNumber $used $attr $required} v]} {
if {$v != "Skip rest!"} {
error
} elseif {!$required} {
set i [llength $allatts]
} else {
set v ""
}
} elseif {[string length $v]} {
append text [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $v]"]
}
} else {
# other attribute
if {$promptNoisily} {beep}
if {[catch {htmlStatusAskAttr $used $attr $required} v]} {
if {$v != "Skip rest!"} {
error
} elseif {!$required} {
set i [llength $allatts]
} else {
set v ""
}
} elseif {[string length $v]} {
htmlOpenExtraThings $used $attr $v
if {[lsearch -exact $eventatts $attr] < 0} {
set attr [htmlSetCase $attr]
}
append text [htmlWrapTag "$attr[htmlAddQuotes $v]"]
}
}
if {![string length $v] && $required } {
alertnote "You must give $attr a value."
incr i -1
}
} else {
# yes-no attribute
if {$promptNoisily} {beep}
set v ""
while {[catch {statusPrompt "${used}:$attr \[n\] " htmlStatusAskYesOrNo} v]} {
if {$v == "Cancel all!"} {
message "Cancel"
error
}
if {$v == "Skip rest!"} {
set i [llength $allatts]
break
}
}
if {$v == "yes"} {append text [htmlWrapTag [htmlSetCase $attr]]}
}
}
# Some tests that input is ok.
if {[htmlFontBaseTest $text "message"]} {beep; set text ""}
if {$elem == "A" && [htmlATest $text "message"]} {beep; set text ""}
if {$elem == "FRAMESET" && [htmlFramesetTest $text "message"]} {beep; set text ""}
if {$elem == "SPACER" && [htmlSpacerTest $text "message"]} {beep; set text ""}
if {$elem == "AREA" && [htmlAreaTest $text "message"]} {beep; set text ""}
if {[string length $text] } {append text ">"}
catch {unset htmlActiveUsed}
catch {unset htmlActiveElem}
catch {unset htmlActiveAttr}
catch {unset htmlActiveCache}
catch {unset htmlActiveWidth}
catch {unset htmlActiveHeight}
return ${text}
}
# Choose a color name or add a color number
proc htmlAskColor {attr required} {
global HTMLmodeVars htmlColorTabSeen htmlActiveUsed htmlColorName
global basicColors htmluserColors htmlColors htmlActiveColor
set promptNoisily $HTMLmodeVars(promptNoisily)
# put users colours first
set htmlColors [lsort [array names htmluserColors]]
append htmlColors " " $basicColors
while {1} {
# Loop until input is valid or everything is cancelled, then something is returned
if {$promptNoisily} {beep}
set htmlColorTabSeen 0
set pr ""
if {!$required} { set pr "(optional) "}
append pr ${htmlActiveUsed}:${attr}
while {[catch {statusPrompt $pr htmlColorStatusFunc} r]} {
if {$r == "Cancel all!"} {
message "Cancel"
error
}
if {$r == "Continue!"} {
set r $htmlActiveColor
unset htmlActiveColor
break
}
if {$r == "Skip rest!"} {error "Skip rest!"}
}
set r [string trim $r]
if {![string length $r]} {return}
# Users own color?
if {[info exists htmluserColors($r)]} {return $htmluserColors($r)}
# Predefined color?
if {[info exists htmlColorName($r)]} {
return $htmlColorName($r)
} else {
set col [htmlCheckColorNumber $r]
if {$col != 0} {
return $col
} else {
alertnote "$r is not a valid color number. It should be of the form #RRGGBB."
}
}
}
}
proc htmlColorStatusFunc {curr c} {
global htmlActiveAttr htmlColorTabSeen htmlColorName
global htmlColors htmlActiveColor htmlActiveUsed
if {$c == "\032"} {
error "Cancel all!"
}
if {$c == "\021"} {error "Skip rest!"}
# ctrl-f is new color.
if {$c == "\006"} {
set newcolor [htmlAddNewColor]
if {[string length $newcolor]} {
set htmlActiveColor $newcolor
error "Continue!"
} else {
return
}
}
if {$c != "\t"} {
set htmlColorTabSeen 0
return $c
}
set matches {}
set attr $htmlActiveAttr
foreach w $htmlColors {
if {[string match "$curr*" $w]} {
lappend matches $w
}
}
if {![llength $matches]} {
beep
} else {
if {$htmlColorTabSeen} {
if {[catch {listpick -p ${htmlActiveUsed}:${htmlActiveAttr} $matches} ret]} {
set ret ""
}
if {[string length $ret]} {
set htmlActiveColor $ret
error "Continue!"
}
set htmlColorTabSeen 0
} else {
set htmlColorTabSeen 1
set ret [string range [largestPrefix $matches] [string length $curr] end]
}
return $ret
}
return
}
# HREF attributes are handled as a listpick from a cached list
proc htmlAskURL {attr required} {
global htmlURLTabSeen
global HTMLmodeVars htmlActiveUsed htmlActiveCache htmlActiveURL
if {$HTMLmodeVars(promptNoisily)} {beep}
set htmlURLTabSeen 0
if {!$required} { set pr "(optional) "}
append pr ${htmlActiveUsed}:${attr}
while {[catch {statusPrompt $pr htmlURLStatusFunc} r]} {
if {$r == "Cancel all!"} {
message "Cancel"
error
}
if {$r == "Continue!"} {
set r $htmlActiveURL
unset htmlActiveURL
break
}
if {$r == "Skip rest!"} {error "Skip rest!"}
}
set r [string trim $r]
htmlAddToCache $htmlActiveCache $r
return $r
}
proc htmlURLStatusFunc {curr c} {
global HTMLmodeVars htmlActiveAttr htmlURLTabSeen htmlActiveCache htmlActiveURL
global htmlActiveUsed htmlActiveWidth htmlActiveHeight
set htmlActiveWidth ""
set htmlActiveHeight ""
if {$c == "\032"} {
error "Cancel all!"
}
if {$c == "\021"} {error "Skip rest!"}
if {$htmlActiveCache == "windows"} {set URLs {_self _top _parent _blank}}
append URLs " " $HTMLmodeVars($htmlActiveCache)
# ctrl-f for file dialog.
if {$c == "\006"} {
if {$htmlActiveCache == "windows"} {
beep
return
}
set newURL [htmlGetFile]
if {[string length $newURL]} {
set htmlActiveURL [lindex $newURL 0]
if {[llength [set nnn [lindex $newURL 1]]]} {
set htmlActiveWidth [lindex $nnn 0]
set htmlActiveHeight [lindex $nnn 1]
}
error "Continue!"
} else {
return
}
}
if {$c != "\t"} {
set htmlURLTabSeen 0
return $c
}
set matches {}
set attr $htmlActiveAttr
foreach w $URLs {
if {[string match "$curr*" $w]} {
lappend matches $w
}
}
if {![llength $matches]} {
beep
} else {
if {$htmlURLTabSeen} {
if {[catch {listpick -p ${htmlActiveUsed}:${htmlActiveAttr} $matches} ret]} {
set ret ""
}
if {[string length $ret]} {
set htmlActiveURL $ret
error "Continue!"
}
set htmlURLTabSeen 0
} else {
set htmlURLTabSeen 1
set ret [string range [largestPrefix $matches] [string length $curr] end]
}
return $ret
}
return
}
proc htmlStatusAskAttr {used attr required} {
global htmlAttrTabSeen htmlActiveInput
set htmlAttrTabSeen 0
if {!$required} {
set pr "(optional) "
} else {
set pr {}
}
if {$used == "LI IN UL" || $used == "LI IN OL"} { # these two are special
append pr LI:$attr
} else {
append pr ${used}:$attr
}
set v ""
while {[catch {statusPrompt $pr htmlAttrStatusFunc} v]} {
if {$v == "Cancel all!"} {
message "Cancel"
error
}
if {$v == "Continue!"} {
set v $htmlActiveInput
unset htmlActiveInput
break
}
if {$v == "Skip rest!"} {error "Skip rest!"}
}
# Trim only if it's only spaces.
if {[string trim $v] == ""} {set v ""}
# if there are choices, check if the user has typed one.
set choices [htmlGetChoices $used]
set matches {}
set areChoices [string match "*${attr}*" $choices]
if {!$areChoices} {
return $v
} else {
foreach w $choices {
if {($used == "LI IN OL" || $used == "OL") && $attr == "TYPE="} { # special case
set c ${attr}$v
} else {
set c [string toupper "${attr}${v}*"]
}
if {[string match "${c}*" $w]} {
lappend matches $w
}
}
# if unique extension, add what's needed, otherwise return nothing.
if {[llength $matches] == 1 && [string length $v]} {
set ret [string range $matches [string length $attr] end]
if {($used != "LI IN OL" && $used != "OL") || $attr != "TYPE="} {
set ret [htmlSetCase $ret]
}
return $ret
} else {
return
}
}
}
# CDATA element attribute, status window match completion
proc htmlAttrStatusFunc {curr c} {
global htmlActiveUsed htmlActiveAttr htmlAttrTabSeen htmlActiveInput
if {$c == "\032"} {error "Cancel all!"}
if {$c == "\021"} {error "Skip rest!"}
# should we set the case or not (are there predefined choices)?
set choices [htmlGetChoices $htmlActiveUsed]
set matches {}
set attr $htmlActiveAttr
set areChoices [string match "*${attr}*" $choices]
foreach w $choices {
if {($htmlActiveUsed == "LI IN OL" || $htmlActiveUsed == "OL") \
&& $attr == "TYPE="} { # special case
if {[string match "${attr}${curr}*" $w]} {
lappend matches [string range $w [string length $attr] end]
}
} elseif {[string match [string toupper "${attr}${curr}*"] $w]} {
lappend matches [string range $w [string length $attr] end]
}
}
if {$c != "\t" } {
set htmlAttrTabSeen 0
if {$areChoices} {
# check if the last character matches
set matches {}
foreach w $choices {
if {[string match [string toupper "${attr}${curr}${c}*"] $w]} {
lappend matches [string range $w [string length $attr] end]
}
}
if {[llength $matches]} {
if {($htmlActiveUsed != "LI IN OL" && $htmlActiveUsed != "OL") \
|| $attr != "TYPE="} { # special case
set c [htmlSetCase $c]
}
return $c
} else {
beep
return
}
} else {
return $c
}
}
# it's a tab
if {![llength $matches]} {
beep
} else {
if {$htmlAttrTabSeen} {
if {[catch {listpick -p ${htmlActiveUsed}:${htmlActiveAttr} $matches} ret]} {
set ret ""
}
if {[string length $ret]} {
set htmlActiveInput $ret
error "Continue!"
}
set htmlAttrTabSeen 0
} else {
set htmlAttrTabSeen 1
set ret [string range [largestPrefix $matches] [string length $curr] end]
}
if {($htmlActiveUsed != "LI IN OL" && $htmlActiveUsed != "OL") \
|| $attr != "TYPE="} {
# special case
set ret [htmlSetCase $ret]
}
return $ret
}
return
}
# ask for an attribute which is a number. Returns "" if input is not valid.
proc htmlAskNumber {item attr required} {
global HTMLmodeVars htmlActiveWidth htmlActiveHeight
set promptNoisily $HTMLmodeVars(promptNoisily)
# loop until input is valid, then something is returned
while {1} {
if {$promptNoisily} {beep}
set pr ""
if {!$required} { set pr "(optional) "}
# these two are special
if {$item == "LI IN UL" || $item == "LI IN OL"} {
append pr LI:$attr
} else {
append pr ${item}:$attr
}
if {$item == "IMG" && $attr == "WIDTH=" && [string length $htmlActiveWidth]} {
append pr " \[$htmlActiveWidth\] "
} elseif {$item == "IMG" && $attr == "HEIGHT=" && [string length $htmlActiveHeight]} {
append pr " \[$htmlActiveHeight\] "
}
while {[catch {statusPrompt $pr htmlNumberStatusFunc} r]} {
if {$r == "Cancel all!"} {
message "Cancel"
error
}
if {$r == "Skip rest!"} {error "Skip rest!"}
}
set r [string trim $r]
# if no input, just return
if {![string length $r]} {
if {$item == "IMG" && $attr == "WIDTH="} {
return $htmlActiveWidth
} elseif {$item == "IMG" && $attr == "HEIGHT="} {
return $htmlActiveHeight
} else {
return
}
}
# check that input is valid.
set numcheck [htmlCheckAttrNumber $item $attr $r]
if {$numcheck == 1} {
return $r
} else {
alertnote "Invalid input. $numcheck"
}
}
}
proc htmlNumberStatusFunc {curr c} {
if {$c == "\032"} {error "Cancel all!"}
if {$c == "\021"} {error "Skip rest!"}
if {[lsearch -exact {+ - 0 1 2 3 4 5 6 7 8 9 %} $c] >=0 } {
return $c
} else {
beep
}
}
# Force yes or no in the status window
proc htmlStatusAskYesOrNo {curr c} {
if {$c == "\032"} {error "Cancel all!"}
if {$c == "\021"} {error "Skip rest!"}
set c [string tolower $c]
if {![string length $curr]} {
if {$c == "n"} {return "no"}
if {$c == "y"} {return "yes"}
}
beep
return
}
# From menu, customize list of attributes which get asked about
proc htmlUseAttrs {item} {
global HTMLmodeVars htmlPackageToUse modifiedVars
global htmlElemAttrUsed htmlElemAttrUsed3
global htmlElemAttrMore htmlElemAttrMore3
set reqattrs [htmlGetRequired $item]
set used [htmlGetUsed $item]
set askformore [htmlGetAttrMore $item]
set optatts [htmlGetOptional $item]
set attrnumber [llength $optatts]
set height [expr 95 + (( $attrnumber - 1) / 3 + 1) * 20]
set box "-w 400 -h $height -b OK 20 [expr $height - 30] 85 [expr $height - 10] \
-b Cancel 110 [expr $height - 30] 175 [expr $height - 10] \
-t {Select the optional attributes you want for $item} 10 10 450 30 "
lappend box -t {Ask for more?} 10 [expr $height - 55] 110 [expr $height - 40] \
-r Yes $askformore 120 [expr $height - 55] 160 [expr $height - 40] \
-r No [expr !$askformore] 180 [expr $height - 55] 220 [expr $height - 40]
# see which attributes were used previously
set wpos 10
set hpos 35
foreach attr $optatts {
if {[lsearch -exact $used $attr] >= 0} {
set checked 1
} else {
set checked 0
}
lappend box -c [string trimright $attr =] $checked $wpos $hpos [expr $wpos + 120] [expr $hpos + 15]
set wpos [expr $wpos + 130]
if {$wpos > 310} {
set wpos 10
set hpos [expr $hpos + 20]
}
}
# get the new ones wanted
set newatts [eval [concat dialog $box]]
set newuse {}
if {[lindex $newatts 0]} {
for {set i 0} {$i < $attrnumber} {incr i} {
if {[lindex $newatts [expr $i + 4]]} {
lappend newuse [lindex $optatts $i]
}
}
set newuse [concat $reqattrs $newuse]
if {$htmlPackageToUse == 1} {
set num ""
} else {
set num 3
}
set htmlElemAttrUsed${num}($item) $newuse
addArrDef htmlElemAttrUsed$num $item $newuse
set htmlElemAttrMore${num}($item) [lindex $newatts 2]
addArrDef htmlElemAttrMore$num $item [lindex $newatts 2]
}
}